home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / vmmngr.zip / VMM.IN4 < prev    next >
Text File  |  1990-07-16  |  9KB  |  274 lines
  1. {*********************************************************}
  2. {*                   VMM.IN4 1.00                        *}
  3. {*********************************************************}
  4.  
  5.   {+++ Internal methods +++}
  6.  
  7.   function VMM.PageOut(SizeNeeded : LongInt) : Boolean;
  8.     {-Page out until "SizeNeeded" bytes become available in the Ram area}
  9.     { Return false if not possible}
  10.   var
  11.     Failed     : Boolean;
  12.     CurHandle  : VmmHandle;
  13.     SD         : VmmDescriptor;
  14.     D          : VmmDescriptor;
  15.     P          : VmmPtr;
  16.     Index      : Byte;
  17.     Err        : Word;
  18.   begin
  19.    Failed := false;
  20.      if vmLruQueue.IsEmpty then begin  {Nothing to page out - this}
  21.      PageOut := false;                 { error should not occur unless}
  22.      Exit;                             { ClearRamArea has been called}
  23.    end;                                { twice in a row}
  24.  
  25.    while (not vmLruQueue.IsEmpty)
  26.          and (RamMaxAvail < SizeNeeded)
  27.          and not Failed do begin
  28.      vmLruQueue.PeekHead(CurHandle);            {Get next LRU handle}
  29.      vmDescTable.GetElem(CurHandle, D);         {Load descriptor}
  30.      if vmDescTable.GetStatus <> 0 then begin
  31.        PageOut := false;
  32.        Error(epFatal+ecBadParam);
  33.        Exit;
  34.      end;
  35.      SD := D;
  36.      Failed := true;  {Assume failure}
  37.  
  38.      if EmsMaxAvail >= D.Size then begin
  39.      {Find a free entry or allocate Ems then map Ems and move data}
  40.        P := vmEmsFreeList.GetFreeEntry(D.Size);
  41.        if P <> nil then
  42.          D.Ptr := P
  43.        else begin
  44.        {Allocate Ems}
  45.          D.Handle := AllocateEmsPages(4);
  46.          if D.Handle = EmsErrorCode then begin
  47.            PageOut := false;
  48.            Error(epFatal+ecEmsAllocation);
  49.            Exit;
  50.          end;
  51.          D.Offset := 0;
  52.          {Add free entry to make later use of remaining space in frame}
  53.          if vmEmsFreeList.AddFreeEntry(Ptr(D.Handle, D.Size),
  54.                                        MaxEmsBlock-D.Size) = 0 then
  55.            Error(epNonFatal+ecOutOfEmsEntries);
  56.        end;
  57.        if not SaveEmsContext(D.Handle) then begin
  58.          PageOut := false;
  59.          Error(epFatal+ecEmsPageMapping);
  60.          Exit;
  61.        end;
  62.        {Map Ems - We deal with 64k blocks only}
  63.        for Index := 0 to 3 do
  64.          if not MapEmsPage(D.Handle, Index, Index) then begin
  65.            PageOut :=false;
  66.            Error(epFatal+ecEmsPageMapping);
  67.            Exit;
  68.          end;
  69.        {Move data to Ems}
  70.        Move(SD.RamPtr^, Ptr(vmEmsBaseSeg, D.Offset)^, D.Size);
  71.        if not RestoreEmsContext(D.Handle) then begin
  72.          PageOut := false;
  73.          Error(epFatal+ecEmsPageMapping);
  74.          Exit;
  75.        end;
  76.        D.Location := vmInEms;
  77.        Failed := false;
  78.      end
  79.  
  80.      else if DskMaxAvail >=  D.Size then begin
  81.      {Allocate disk space and move data}
  82.        P := vmDskFreeList.GetFreeEntry(D.Size);
  83.        if P <> nil then
  84.          D.DskPtr := LongInt(P)
  85.        else begin
  86.        {No free block - append to end of file}
  87.          D.DskPtr := vmEofPtr;
  88.          Inc(vmEofPtr, D.Size);
  89.        end;
  90.        Seek(vmF, D.DskPtr);
  91.        BlockWrite(vmF, SD.RamPtr^, D.Size);
  92.        Err := IoResult;
  93.        if Err <> 0 then begin
  94.          PageOut := false;
  95.          Error(epFatal+Err);
  96.          Exit;
  97.        end;
  98.        D.Location := vmOnDsk;
  99.        Failed := false;
  100.      end;
  101.  
  102.      if not Failed then begin
  103.      {Block has been paged out}
  104.        {Update RamFreeList and descriptor table}
  105.        if vmRamFreeList.AddFreeEntry(SD.RamPtr, D.Size) = 0 then
  106.          Error(epNonFatal+ecOutOfRamEntries);
  107.        vmDescTable.SetElem(CurHandle, D);
  108.        {Remove handle from free list only if paged out}
  109.        vmLruQueue.PopHead(CurHandle);
  110.      end;
  111.    end;
  112.    PageOut := RamMaxAvail >= SizeNeeded;
  113.   end;
  114.  
  115.   function VMM.GetHandle : Word;
  116.     {-Return a valid VMM handle}
  117.   var
  118.     CurIndex  : Word;
  119.     CurDesc   : VmmDescriptor;
  120.     LastIndex : Word;
  121.   begin
  122.     with vmDescTable do begin
  123.       if daValidElems = 0 then
  124.         GetHandle := 0
  125.       else begin
  126.         LastIndex := Pred(daValidElems);
  127.         for CurIndex := 0 to LastIndex do begin
  128.         {Look for a null entry in descriptor table}
  129.           GetElem(CurIndex, CurDesc);
  130.           if CurDesc.Location = 0 then begin
  131.           {Assume that entry is free if Location is null}
  132.             GetHandle := CurIndex;
  133.             Exit;
  134.           end;
  135.         end;
  136.         {not found, the next one will be the last valid one + 1}
  137.         if LastIndex >= GetMaxIndex then begin
  138.           GetHandle := OutOfHandles;
  139.           Error(epFatal+ecOutOfDescEntries);
  140.         end
  141.         else
  142.           GetHandle := Succ(LastIndex);
  143.       end;
  144.     end;
  145.   end;
  146.  
  147.   destructor VMMDescriptorTable.Done;
  148.     {-Deallocate all Ems handles held in descriptor table}
  149.   var
  150.     D         : VmmDescriptor;
  151.     Index     : Word;
  152.   begin
  153.     if daValidElems > 0 then
  154.       for Index := 0 to Pred(daValidElems) do begin
  155.         GetElem(Index, D);
  156.         if FlagIsSet(Word(D.Location), vmInEms)
  157.         and not DeAllocateEmsHandle(D.Handle) then
  158.           Error(epNonFatal+ecCantFreeEms);
  159.       end;
  160.     DynArray.Done;
  161.   end;
  162.  
  163.   {---------------------------------------------------------------------}
  164.  
  165.   {+++ Internal procedures +++}
  166.   function VmmGetMem(var P; Size : LongInt) : Boolean;
  167.     {-Allocate heap space, returning true if successful}
  168.     { Default function for UserGetMem}
  169.   var
  170.     Pt : Pointer absolute P;
  171.   begin
  172.     GetMem(Pt, Word(Size));     {We only use WORDs inside a VMM}
  173.     VmmGetMem := (Pt <> nil);
  174.   end;
  175.  
  176.   procedure VmmFreeMem(var P; Size : LongInt);
  177.     {-Deallocate heap space}
  178.     { Default procedure for UserFreeMem}
  179.   var
  180.     Pt : Pointer absolute P;
  181.   begin
  182.     if Pt <> nil then begin
  183.       FreeMem(Pt, Word(Size));  {We only use WORDs inside a VMM}
  184.       Pt := nil;
  185.     end;
  186.   end;
  187.  
  188.   procedure DerefHandler(AX, BX, CX, DX, SI ,DI, DS, ES, BP : Word);
  189.   interrupt;
  190.     {-Called when a pointer is dereferenced with VmmDrf}
  191.   var
  192.     P        : Pointer;
  193.     D        : VmmDescriptor;
  194.     H        : Word;
  195.     Err      : Word;
  196.     Location : Byte;
  197.     Page     : Byte;
  198.     Locked   : Boolean;
  199.   begin
  200.     with VmmActiveMgr^ do begin {VMM selected with LinkToDerefHandler}
  201.       {AX contains VMM handle}
  202.       H := AX;                                  {Save Handle}
  203.       vmDescTable.GetElem(H, D);                {Get descriptor}
  204.       if (BX = VmmMark) and (vmDescTable.GetStatus = 0) then begin
  205.         Locked := FlagIsSet(Word(D.Location), vmLocked);
  206.         Location := D.Location and vmLocation;
  207.         case Location of
  208.           vmInRam:
  209.                begin                            {Block is in Ram area}
  210.                  DX := VmmPtrRec(D.RamPtr).Seg;
  211.                  AX := VmmPtrRec(D.RamPtr).Ofs;
  212.                end;
  213.  
  214.           vmInEms, vmOnDsk:
  215.                begin                            {Block is in Ems or on Disk}
  216.                  {Make room for block in Ram if necessary}
  217.                  if not(RamMaxAvail >= D.Size) then
  218.                    if not PageOut(D.Size) then
  219.                      ErrorExit(213); {dead lock - shouldn't occur}
  220.                  P := vmRamFreeList.GetFreeEntry(D.Size);
  221.                  {P cannot be nil if we get here}
  222.  
  223.                  case Location of
  224.                    vmInEms:
  225.                      begin  {Ems}
  226.                        if not SaveEmsContext(D.Handle) then
  227.                          ErrorExit(212);
  228.                        for Page := 0 to 3 do
  229.                          if not MapEmsPage(D.Handle, Page, Page) then
  230.                            ErrorExit(212);
  231.                        Move(Ptr(vmEmsBaseSeg, D.Offset)^, P^, D.Size);
  232.                        if not RestoreEmsContext(D.Handle) then
  233.                          ErrorExit(212);
  234.                        if vmEmsFreeList.AddFreeEntry(D.Ptr, D.Size) = 0 then
  235.                          Error(epNonFatal+ecOutOfEmsEntries);
  236.                      end;
  237.                    vmOnDsk:
  238.                      begin  {Disk}
  239.                        Seek(vmF, D.DskPtr);
  240.                        BlockRead(vmF, P^, D.Size);
  241.                        Err := IOResult;
  242.                        if Err <> 0 then
  243.                          ErrorExit(Err); {Can only generate run-time error}
  244.                        if vmDskFreeList.AddFreeEntry(D.Ptr, D.Size) = 0 then
  245.                          Error(epNonFatal+ecOutOfDskEntries);
  246.                      end;
  247.                  end;
  248.  
  249.                  {Update descriptor table}
  250.                  D.Location := vmInRam;
  251.                  D.RamPtr := P;
  252.                  vmDescTable.SetElem(H, D);
  253.                  {Return pointer to block in ram area}
  254.                  DX := VmmPtrRec(P).Seg;
  255.                  AX := VmmPtrRec(P).Ofs;
  256.                end;
  257.           else {Handle not recognized}
  258.              ErrorExit(204); {Invalid pointer operation}
  259.         end;
  260.         {Add handle to LRU queue}
  261.         if not Locked then with vmLruQueue do begin
  262.           Remove(H);   {Make H a unique handle in the LRU queue}
  263.           PushTail(H);
  264.         end;
  265.       end
  266.       else begin
  267.         {Must be a normal TP pointer - return it unchanged}
  268.         DX := AX;
  269.         AX := BX;
  270.       end;
  271.     end;
  272.   end;
  273.  
  274.